home *** CD-ROM | disk | FTP | other *** search
/ Gekkan Dennou Club 147 / Gekkan Dennou Club - 2000.8 Vol. 147 (Japan).7z / Gekkan Dennou Club - 2000.8 Vol. 147 (Japan) (Track 1).bin / docs / perl / mscalar1.pl < prev    next >
Perl Script  |  2000-06-25  |  1KB  |  67 lines
  1. # タイによるスカラーの監視
  2. package MonScalar;
  3.  
  4. sub TIESCALAR {
  5.     my ($pkg, $name, $value) = @_;
  6.     my $obj = { name => $name, value => $value };
  7.     bless $obj, $pkg;
  8.     $obj;
  9. }
  10.  
  11. sub FETCH {
  12.     my $obj = shift;
  13.     print 'Read : $', $obj->{'name'}, " -> $obj->{'value'}\n";
  14.     $obj->{'value'};
  15. }
  16.  
  17. sub STORE {
  18.     my ($obj, $new_value) = @_;
  19.     print 'Write : $', $obj->{'name'}," <- $new_value\n";
  20.     $obj->{'value'} = $new_value;
  21. }
  22.  
  23. sub DESTROY {
  24.     my $obj = shift;
  25.     if( $obj->{'name'} ne '__UNMONITOR__' ){
  26.     print 'DESTORY $', "$obj->{'name'}\n";
  27.     }
  28. }
  29.  
  30.  
  31. sub unmonitor {
  32.     my ($pkg, $rvar) = @_;
  33.     my $last_value;
  34.     {
  35.     my $obj = tied $$rvar;
  36.     $last_value = $obj->{'value'};
  37.     $obj->{'name'} = '__UNMONITOR__'
  38.     }
  39.     untie $$rvar;
  40.     $$rvar = $last_value;
  41. }
  42.  
  43.  
  44. package main;
  45.  
  46. $x = 10;
  47. tie $x, 'MonScalar', 'x', $x;
  48.  
  49. $y = $x;
  50. print "y -> $y\n";
  51.  
  52. $x = 100;
  53. $z = $x;
  54. print "z -> $z\n";
  55.  
  56. MonScalar->unmonitor( \$x );
  57.  
  58. print "x -> $x\n";
  59.  
  60. {
  61.     my $x1 = 100;
  62.     tie $x1, 'MonScalar', 'x1', $x1;
  63.     $x1 = 1000;
  64. }
  65.  
  66. # end of file;
  67.